      PROGRAM NASAM
CSE
CPS      PURPOSE:
C
C             PROGRAM TO READ A COSMIC/NASTRAN OUTPUT2 BINARY DATA
C             FILE AND CREATE A FORMATED DATA FILE WHICH MAY BE
C             READ VIA USE OF SAMSAN LIBRARY READ DATA SUBROUTINES:
C
C                          READ,  READIM  AND READD
C
C             A LIST OF COMMON NASTRAN LABELS AND LABELS ASSOCIATED
C             WITH THE OUTPUT2 CAPABILITIES OF THE NASTRAN/DISCOS/SAMSAN
C             DMAP BRIDGING PROGRAM ARE DEFINED WITHIN THIS PROGRAM.
C             IF A LABEL FOUND ON THE OUTPUT2 FILE MATCHES ONE OF THE
C             LABELS STORED HEREIN DESCRIPTIVE INFORMATION IS PLACED
C             IN THE COMMENT AREA OF THE HEADER CARD FOR THE MATRIX
C             RECOGNIZED. ALL MATRICES IN THE OUTPUT DATA FILE OF THIS
C             PROGRAM ARE SEPERATED BY A CHARACTER*8 LABEL. THIS LABEL
C             MAY BE USED FOR DATA SEARCHING IN A FOLLOW-ON PROGRAM.
C
CPE
C
C     PROGRAM NASAM IS AN EXTENSION OF THE PROGRAM RDOUT2 WRITTEN BY
C     R.MITCHELL IN NOV, 1974 FOR NASTRAN LEVEL 15.5.
C
C     PROGRAM NASAM HAS BEEN WRITTEN BY H.P.FRISCH, APRIL 1983 
C     FOR COSMIC/NASTRAN LEVEL 17.5.
C
CAS          ***   ARGUMENT LIST  ***
C
C    LABEL1     CHARACTER*8 LABEL FOUND THAT THE HEAD OF A DATA BLOCK
C
C    LABEL2     CHARACTER*8 DMAP DATA BLOCK NAME, MAY DIFFER FROM LABEL1
C
C    NAMET      CHARACTER*8 ARRAY OF RECOGNIZABLE NASTRAN DMAP TABLE
C               DATA BLOCK NAMES.
C
C    IRMRKT     CHARACTER*65 ARRAY OF REMARKS ASSOCIATED WITH
C               CORRESPONDING ENTRIES IN ARRAY "NAMET"
C
C    NAMEP      CHARACTER*8 ARRAY OF RECOGNIZABLE NASTRAN DMAP MATRIX
C               DATA BLOCK NAMES ASSOCIATED WITH PARTITIONING VECTORS.
C
C    IRMRKP     CHARACTER*65 ARRAY OF REMARKS ASSOCIATED WITH
C               CORRESPONDING ENTRIES IN ARRAY "NAMEP"
C
C    NAMES      CHARACTER*8 ARRAY OF RECOGNIZABLE NASTRAN DMAP REAL*8
C               MATRIX DATA BLOCK NAMES.
C
C    IRMRKS     CHARACTER*65 ARRAY OF REMARKS ASSOCIATED WITH
C               CORRESPONDING ENTRIES IN ARRAY "NAMES"
C
C    MAXDBN     MAXIMUM NUMBER OF RECOGNIZABLE DATA BLOCK NAMES IN
C               EACH CATEGORY
C
C    MAXSZE     MAXIMUM LENGTH ALLOWED FOR ANY INPUT BINARY RECORD
C    DSZE       LENGTH OF REAL*8 ARRAY INTO WHICH RECORD WILL BE LOADED,
C               IT MUST BE ONE HALF OF MAXSZE.
C
C    LTAPE      LOGICAL CONTROL FLAG
C               LTAPE = .TRUE.  PROVIDES OCTAL LIST OF FULL OUTPUT2 FILE
C                       .FALSE. DOESN'T
C
CAE
COS             ****  NASTRAN OUTPUT DATA  ****
C
C      EACH TABLE WRITTEN IN BINARY VIA THE OUTPUT2 NASTRAN CAPABILITY
C      REQUIRES SPECIAL PROCESSING CODE. EXACT TABLE LAYOUT DEFINITIONS
C      ARE AVAILABLE IN THE NASTRAN PROGRAMMERS MANUAL. THIS PROGRAM
C      RECOGNIZES A FEW OF THE TABLE COMMON TO DYNAMIC ANALYSIS. TABLES
C      NOT RECOGNIZED ARE OUTPUTTED IN HEXIDECIMAL.
C
C         GPL  ***  GRID POINT LIST FROM FUNCTIONAL MODULE (FM) GP1
C
C     RECORD 1 - LIST OF EXTERNAL GRID AND SCALAR NUMBERS IN INTERNAL
C                SORT, OUTPUT USING PUNCHI FORMAT. MATRIX ID = GPLR1.
C     RECORD 2 - PAIRS OF EXTERNAL GRID AND SCALAR NUMBERS AND SEQUENCE
C                NUMBERS IN INTERNAL SORT, OUTPUT AS TWO COLUMN REAL*4
C                ARRAY USING PUNCH FORMAT. MATRIX ID = GPLR2.
C
C       BGPDT  ***  BASIC GRID POINT DEFINITION TABLE FROM FM GP1
C
C     RECORD 1 - LIST OF COORDINATE SYSTEM ID AND X,Y,Z COORDINATES
C                FOR EACH GRID OR SCALAR POINT, OUTPUT AS FOUR COLUMN
C                REAL*4 ARRAY USING PUNCH FORMAT. MATRIX ID = BGPDT.
C
C        OGPWG  ***  GRID POINT WEIGHT GENERATOR TABLE FROM FM GPWG
C
C        LAMA   ***  REAL EIGENVALUE TABLE FROM FM READ
C
C        OPHIG  ***  REAL EIGENVECTOR TABLE FROM FM SDR2
C
C        USET  ***  DISPLACEMENT SET DEFINITION TABLE FROM FM GP4
C
C     RECORD 1 - LIST OF ALL BINARY CODED WORDS USED TO DEFINE TO
C                WHICH DISPLACEMENT SETS EACH DEGREE OF FREEDOM IS
C                ASSIGNED, SEE FUNCTIONAL MODULE VEC DESCRIPTION FOR
C                BIT LOCATION/SET CODE. OUTPUT AS ONE ROW OF HEXI-
C                DECIMAL NUMBERS, ONE HEX NUMBER PER DEGREE OF FREEDOM.
C
C       PARTITIONING VECTORS ARE GIVEN SPECIAL CONSIDERATION. THESE ARE
C       ALWAYS COMPOSED OF 1.0'S AND 0.0'S. WE OUTPUT THEM HERE IN
C       INTEGER FORMAT.
C
C      FCMESH  *** FINE TO COARSE MESH PARTITIONING VECTOR
C
C     RECORD 1 - INTEGER ARRAY TO DEFINE IF G-SET DOF IS IN A-SET
C                IF  1  G-SET DOF IS IN A-SET
C                    0  G-SET DOF IS NOT
C
C        FTOA  *** F-SET TO O-SET AND A-SET PARTITIONING VECTOR
C
C      RECORD 1 - INTEGER ARRAY 
C                 IF  1  F-SET DOF IS IN O-SET
C                     0  F-SET DOF IS IN A-SET
C
C       GTOMN  *** G-SET TO M-SET AND N-SET PARTITIONING VECTOR
C
C      RECORD 1 - INTEGER ARRAY
C                 IF  1  G-SET DOF IS IN M-SET
C                     0  G-SET DOF IS IN N-SET
C
C        GTMN  ***  SAME AS GTOMN
C
C        NTSF  *** N-SET TO S-SET AND F-SET PARTITIONING VECTOR
C
C      RECORD 1 - INTEGER ARRAY
C                 IF  1  N-SET DOF IS IN S-SET
C                     0  N-SET DOF IS IN F-SET
C
C     MATRICES IN NASTRAN MAY BE REAL*4, REAL*8, COMPLEX*8 OR COMPLEX*16
C     THIS PROGRAM WILL OUTPUT REAL*4 MATRICES IN A FORMAT COMPATIBLE 
C     SAMSAN SUBROUTINE READ, REAL*8 MATRICES ARE COMPATIBLE WITH 
C     SAMSAN SUBROUTINE READD. COMPLEX MATRICES ARE OUTPUT IN HEX.
C
COE
C
      PARAMETER    MAXSZE=1000, DSZE=500, MAXDBN=100
      CHARACTER*8  LABEL1,  LABEL2,  NAMET(MAXDBN),  NAMEP(MAXDBN)
      CHARACTER*8  NAMES(MAXDBN)
      CHARACTER*65 IRMRKT(MAXDBN), IRMRKP(MAXDBN), MEST, MESS
      CHARACTER    MESM*25,  MESTY(4)*12,  MESFM(8)*12
      CHARACTER*65 IRMRKS(MAXDBN)
      INTEGER      INPUT(MAXSZE), IMAT(MAXSZE,14), IN(2)
      INTEGER      PRT, PCH, IO2
      REAL*4       RMAT(MAXSZE,4), RROW(1), RCOL(1)
      REAL*8       DMAT(DSZE,3), DCOL(1)
      LOGICAL      LTAPE, QUKOUT
C
      EQUIVALENCE  (RMAT(1,1),RROW(1)), (INPUT(1),RCOL(1))
      EQUIVALENCE  (INPUT(1),DCOL(1))
C
      DATA         LTAPE/.FALSE./
      DATA         QUKOUT/.TRUE./
C
C         MATRIX FORM AND TYPE DATA STATEMENTS
C
      DATA  MESTY(1)/'  REAL*4'/
      DATA  MESTY(2)/'  REAL*8'/
      DATA  MESTY(3)/'  COMPLEX*8'/
      DATA  MESTY(4)/'  COMPLEX*16'/
C
      DATA  MESFM(1)/'  SQUARE'/
      DATA  MESFM(2)/'  RECTANG'/
      DATA  MESFM(3)/'  DIAGONAL'/
      DATA  MESFM(4)/'  LOW TRIANG'/
      DATA  MESFM(5)/'  UP TRIANG'/
      DATA  MESFM(6)/'  SYMMETRIC'/
      DATA  MESFM(7)/'  ROW'/
      DATA  MESFM(8)/'  IDENTITY'/
C
      DATA  MEST/'  TABLE NOT RECOGNIZED, DATA PROVIDED IN HEXIDECIMAL'/
      DATA  MESM/'  UNRECOGNIZED MATRIX IS:'/
C
C        NASTRAN DMAP TABLE DATA BLOCK NAMES AND DEFINITION
C
      DATA  NAMET( 1),IRMRKT( 1)/'GPL','  GRID POINT LIST'/
      DATA  NAMET( 2),IRMRKT( 2)/'BGPDT',
     *                           '  BASIC GRID POINT DEFINITON TABLE'/
      DATA  NAMET( 3),IRMRKT( 3)/'USET',
     *                           '  DISPLACEMENT SET DEFINITIONS TABLE'/
      DATA  NAMET( 4),IRMRKT( 4)/'OGPWG',
     *                       'GRID POINT WEIGHT GENERATOR OUTPUT TABLE'/
      DATA  NAMET( 5),IRMRKT( 5)/'LAMA',
     *                                         'REAL EIGENVALUE TABLE'/ 
      DATA  NAMET( 6),IRMRKT( 6)/'OPHIG',
     *                           '  OUTPUT EIGENVECTOR REQUESTS TABLE'/
C
C        NASTRAN DMAP DATA BLOCK NAMES ASSOCIATED WITH
C        PARTITIONING VECTORS
C
      DATA  NAMEP(1),IRMRKP(1)/'FCMESH',
     *                         '  A-SET AND NOT A-SET IN G-SET'/
      DATA  NAMEP(2),IRMRKP(2)/'FTOA',
     *                         '  O-SET AND A-SET IN F-SET'/
      DATA  NAMEP(3),IRMRKP(3)/'GTOMN',
     *                         '  M-SET AND N-SET IN G-SET'/
      DATA  NAMEP(4),IRMRKP(4)/'GTMN',
     *                         '  M-SET AND N-SET IN G-SET'/
      DATA  NAMEP(5),IRMRKP(5)/'NTSF',
     *                         '  S-SET AND F-SET IN N-SET'/
C
C     NASTRAN DMAP DATA BLOCK NAMES ASSOCIATED WITH REAL*8 MATRICES
C
      DATA  NAMES(1),IRMRKS(1)/'BGG',
     *                         '  G-SET VISCOUS DAMPING '/
      DATA  NAMES(2),IRMRKS(2)/'KGG',
     *                         '  G-SET STIFFNESS MATRIX '/
      DATA  NAMES(3),IRMRKS(3)/'K4GG',
     *                         '  G-SET STRUCTURAL DAMPING MATRIX '/
      DATA  NAMES(4),IRMRKS(4)/'MGG',
     *                         '  G-SET MASS MATRIX '/
      DATA  NAMES(5),IRMRKS(5)/'MAAFC',
     *                         '  A-SET PARTITION OF G-SET MASS MATRIX'/
      DATA  NAMES(6),IRMRKS(6)/'MMMFC',
     *                         '  M-SET PARTITION OF G-SET MASS MATRIX'/
      DATA  NAMES(7),IRMRKS(7)/'MOOFC',
     *                         '  O-SET PARTITION OF G-SET MASS MATRIX'/
      DATA  NAMES(8),IRMRKS(8)/'MSSFC',
     *                         '  S-SET PARTITION OF G-SET MASS MATRIX'/
      DATA  NAMES(9),IRMRKS(9)/'BHH',
     *                         '  MODAL DAMPING MATRIX '/
      DATA  NAMES(10),IRMRKS(10)/'KHH',
     *                         '  MODAL STIFFNESS MATRIX '/
      DATA  NAMES(11),IRMRKS(11)/'MHH',
     *                         '  MODAL MASS MATRIX '/
      DATA  NAMES(12),IRMRKS(12)/'GM',
     *              '  MULTIPOINT CONSTRAINT TRANSFORMATION M TO N-SET'/
      DATA  NAMES(13),IRMRKS(13)/'KOA',
     *                      '  O-A PARTITION OF F-SET STIFFNESS MATRIX'/
      DATA  NAMES(14),IRMRKS(14)/'PHIA',
     *                     '  A-SET EIGENVECTOR MATRIX, INTERNAL SORT '/
      DATA  NAMES(15),IRMRKS(15)/'PHIG',
     *                     '  G-SET EIGENVECTOR MATRIX, INTERNAL SORT'/
      DATA  NAMES(16),IRMRKS(16)/'RG',
     *            '  MULTIPOINT + RIGID ELEMENT CONSTRAINT G TO M-SET'/
      DATA  NAMES(17),IRMRKS(17)/'MODCTL',
     *                     '  MODAL CONTROLLABILITY MATRIX'/
      DATA  NAMES(18),IRMRKS(18)/'MODOBS',
     *                     '  MODAL OBSERVABILITY MATRIX '/
      DATA  NAMES(19),IRMRKS(19)/'MODOSS',
     *                  ' MODAL OBSERVABILITY STEADY STATE'/
      DATA  NAMES(20),IRMRKS(20)/'MODCSS',
     *                  '  MODAL CONTROLLABILITY STEADY STATE'/
      DATA  NAMES(21),IRMRKS(21)/'MFFA',
     *                  '  G-SET MASS MATRIX - (AUGMENTATION MASSES)'/
      DATA  NAMES(22),IRMRKS(22)/'MHHN',
     *                  '  MODAL MASS MATRIX FOR AUGMENTED BODY MODES'/
      DATA  NAMES(23),IRMRKS(23)/'MCB1',
     *                 '  MODAL MASS FOR CRAIG BAMPTON STAGE 1 MODES'/
      DATA  NAMES(24),IRMRKS(24)/'KCB1',
     *              '  MODAL STIFFNESS FOR CRAIG BAMPTON STAGE 1 MODES'/
      DATA  NAMES(25),IRMRKS(25)/'BCB1',
     *              '  MODAL DAMPING FOR CRAIG BAMPTON STAGE 1 MODES'/
      DATA  NAMES(26),IRMRKS(26)/'PHIG1',
     *             '  G-SET STAGE 1 CRAIG BAMPTON MODES, INTERNAL SORT'/
      DATA  NAMES(27),IRMRKS(27)/'MCB2',
     *                 '  MODAL MASS FOR CRAIG BAMPTON STAGE 2 MODES'/
      DATA  NAMES(28),IRMRKS(28)/'KCB2',
     *              '  MODAL STIFFNESS FOR CRAIG BAMPTON STAGE 2 MODES'/
      DATA  NAMES(29),IRMRKS(29)/'BCB2',
     *              '  MODAL DAMPING FOR CRAIG BAMPTON STAGE 2 MODES'/
      DATA  NAMES(30),IRMRKS(30)/'PHIG2',
     *             '  G-SET STAGE 2 CRAIG BAMPTON MODES, INTERNAL SORT'/
      DATA  NAMES(31),IRMRKS(31)/'MCB3',
     *                 '  MODAL MASS FOR CRAIG BAMPTON STAGE 3 MODES'/
      DATA  NAMES(32),IRMRKS(32)/'KCB3',
     *              '  MODAL STIFFNESS FOR CRAIG BAMPTON STAGE 3 MODES'/
      DATA  NAMES(33),IRMRKS(33)/'BCB3',
     *              '  MODAL DAMPING FOR CRAIG BAMPTON STAGE 3 MODES'/
      DATA  NAMES(34),IRMRKS(34)/'PHIG3',
     *             '  G-SET STAGE 3 CRAIG BAMPTON MODES, INTERNAL SORT'/
      DATA  NAMES(35),IRMRKS(35)/'PHIACB1',
     *             '  A-SET STAGE 1 CRAIG BAMPTON MODES, INTERNAL SORT'/
      DATA  NAMES(36),IRMRKS(36)/'PHIACB2',
     *             '  A-SET STAGE 2 CRAIG BAMPTON MODES, INTERNAL SORT'/
      DATA  NAMES(37),IRMRKS(37)/'PHIACB3',
     *             '  A-SET STAGE 3 CRAIG BAMPTON MODES, INTERNAL SORT'/
      DATA  NAMES(38),IRMRKS(38)/'BMATG',
     *                            '  G-SET INPUT COEFFICIENT MATRIX'/
      DATA  NAMES(39),IRMRKS(39)/'CMATG',
     *                            '  G-SET OUTPUT COEFFICIENT MATRIX'/
C
C                    INPUT/OUTPUT UNIT NUMBERS
C
      IO2 = 5
      PRT = 6
      PCH = 7
C
C        OUTPUT FORMAT STATEMENTS
C
  803 FORMAT (1X,A8)
  804 FORMAT (A8,7X,A65)
  805 FORMAT (1X,A8,7X,A65)
  806 FORMAT (16I5)
  807 FORMAT (1X,16I5)
  808 FORMAT (2I5,1P4E17.7)
  809 FORMAT (1X,2I5,1P4E17.7)
  810 FORMAT ('0000000000')
  811 FORMAT (' 0000000000')
  812 FORMAT (2I5,3E21.16)
  814 FORMAT(' *** END OF RECORD ',I4,' ***')
  816 FORMAT (2I5,7Z10)
  817 FORMAT (1X,2I5,7Z10)
  818 FORMAT(' *** END OF FILE ***')
  820 FORMAT(' DMAP DATA BLOCK NAME = ',A8)
  822 FORMAT( 9H0*** KEY=,I8,17H INSTEAD OF 8 ***)
  824 FORMAT(' MATRIX TRAILER DATA',/' NGINO =',I4,', COLS =',I4,
     1      ', ROWS =',I4,', FORM =',I2,', TYPE =',I2,', MAXWRD =',I4,
     2      ', DENSITY =',F7.2)
  826 FORMAT(' DATA BLOCK HEADER = ',A8)
  828 FORMAT(1H0,52H*** MATRIX TOO BIG FOR PROGRAM, (CURRENT COL. SIZE =
     C       I5,7H WORDS))
  830 FORMAT ('GPLR1    1',I5,'  INTERNAL/EXTERNAL GRID POINT SORT')
  831 FORMAT(' GPLR1    1',I5,'  INTERNAL/EXTERNAL GRID POINT SORT')
  832 FORMAT ('GPLR2    2',I5,'  INTERNAL/EXTERNAL/SEQUENCE GRID ',
     *'POINT SORT')
  833 FORMAT (' GPLR2    2',I5,'  INTERNAL/EXTERNAL/SEQUENCE GRID ',
     *'POINT SORT')
  834 FORMAT (A6,I4,'    4',A65)
  836 FORMAT (A6,I4,I5,A65)
  837 FORMAT (1X,A6,I4,I5,A65)
  838 FORMAT (1X,'ERROR, ',A8,' IS NOT A PARTITIONING VECTOR')
  840 FORMAT (2I5,1P3D23.16)
  841 FORMAT (1X,2I5,1P3D23.16)
  842 FORMAT(1H0,18H NORMAL END OF RUN)
  844 FORMAT (' ERROR, PROGRAM IS NOT CODED TO HANDLE MATRICES OF',
     *' TYPE =',I5,',  FORM =',I5,/,10X,
     *' MATRIX WITH LABEL ',A8,' OUTPUTTED COLUMN BY COLUMN IN HEX')
  846 FORMAT (A6,I4,I5,'  RECORD',I4,A54)
  847 FORMAT (1X,A6,I4,I5,'  RECORD',I4,A54)
  848 FORMAT (A6,I4,I5,'  COLUMN ',I4,A52)
  849 FORMAT (1X,A6,I4,I5,'  COLUMN ',I4,A52)
  850 FORMAT (A8,'  DEFINED BY NASTRAN TO BE A MATRIX WHICH IS',2A12)
  851 FORMAT (1X,A8,'  DEFINED BY NASTRAN TO BE A MATRIX WHICH IS',2A12)
  852 FORMAT (I5,'  USED AS REFERENCE POINT FOR GRID POINT WEIGHT',
     *' GENERATOR COMPUTATION')
  853 FORMAT (1X,I5,'  USED AS REFERENCE POINT FOR GRID POINT WEIGHT',
     *' GENERATOR COMPUTATION')
  854 FORMAT ('MO       6    6  RIGID BODY MASS MATRIX IN BASIC ',
     *'COORDINATE SYSTEM')
  855 FORMAT (1X,'MO       6    6  RIGID BODY MASS MATRIX IN BASIC ',
     *'COORDINATE SYSTEM')
  856 FORMAT ('STRAN    3    3  S-TRANSFORMATION MATRIX FOR SCALAR',
     *' MASS PARTITION')
  857 FORMAT (1X,'STRAN    3    3  S-TRANSFORMATION MATRIX FOR SCALAR',
     *' MASS PARTITION')
  858 FORMAT ('MASSCG   3    4  DIRECTION MASS AXIS SYSTEM AND CG')
  859 FORMAT (1X,'MASSCG   3    4  DIRECTION MASS AXIS SYSTEM AND CG')
  860 FORMAT ('CGINER   3    3  INERTIA MATRIX RELATIVE TO CG')
  861 FORMAT (1X,'CGINER   3    3  INERTIA MATRIX RELATIVE TO CG')
  862 FORMAT ('PRINER   3    3  PRINCIPAL INERTIAS')
  863 FORMAT (1X,'PRINER   3    3  PRINCIPAL INERTIAS')
  864 FORMAT ('QTRAN    3    3  Q-TRANSFORMATION MATRIX')
  865 FORMAT (1X,'QTRAN    3    3  Q-TRANSFORMATION MATRIX')
  866 FORMAT ('LAMA  ',I4,'    5  EIGVAL, RAD/SEC, HZ, GEN MASS,',
     *' GEN STIF')
  867 FORMAT (1X,'LAMA  ',I4,'    5  EIGVAL, RAD/SEC, HZ, GEN MASS,',
     *' GEN STIF')
  868 FORMAT ('OPHIG ',I4,'    8  MODE',I4,' EIGENVALUE =',E12.5,
     *'  PT ID,TYP,T1,T2,T3,R1,R2,R3')
  869 FORMAT (1X,'OPHIG ',I4,'    8  MODE',I4,' EIGENVALUE =',E12.5,
     *'  PT ID,TYP,T1,T2,T3,R1,R2,R3')
C
C     LIST OUTPUT2 TAPE IN OCTAL FORMAT IF REQUESTED
C
   10 IF(LTAPE) CALL PRINTT(IO2)
      REWIND IO2
C
C         COSMIC/NASTRAN DOES NOT HAVE A HEADER LABEL
C
C
C     READ DATA BLOCK HEADER NAME, ALL TABLES AND MATRICES WRITTEN
C     VIA OUTPUT2 CHARACTER*8 DATA BLOCK NAME AT START.
C
C     SEARCH FOR HEADER NAME
   15 READ(IO2,END=990) KEY
      IF(KEY.EQ.2) GO TO 25
C       FIRST KEY ON OUTPUT2 FILE OR AFTER END-OF-FILE (KEY=0)
C       SHOULD BE "2". IF AN EMPTY RECORD MAY HAVE BEEN ENCOUNTERED.
C       PRINTS ERROR MESSAGE AND THEN SEARCHES FOR NEXT END-OF FILE.
C       CONTINUE THE SEARCH.
C
C     SEARCH FOR NEXT NASTRAN FILE
C     LOOK FOR AN EOF KEY
   20 READ(IO2,END=990) KEY
      IF(KEY.NE.0) GO TO 20
C     EOF (KEY=ZERO) FOUND, LOOK FOR HEADER
      GO TO 15
C
C     READ DMAP DATA BLOCK NAME.
   25 READ(IO2,END=990) LABEL1
      WRITE(PRT,820) LABEL1
      READ(IO2,END=990) KEY
      IF(KEY.LT.0) IREC=ABS(KEY)
      IF(KEY.LT.0) WRITE(PRT,814) IREC
C     READ MATRIX TRAILER
      READ(IO2,END=990) KEY
C     ERROR IF KEY .NE. 8
      IF(KEY.EQ.8) GO TO 30
      WRITE(PRT,822) KEY
      GO TO 999
C
C        MATRIX TRAILER CODE:   (MAY OR MAY NOT HAVE MEANING FOR TABLES)
C           NGINO = GINO NAME 
C                   .EQ.101 FOR OUTPUT2 INPUT DATA BLOCK ONE
C                   .EQ.102 FOR OUTPUT2 INPUT DATA BLOCK TWO
C                   .EQ.103 FOR OUTPUT2 INPUT DATA BLOCK THREE
C                   .EQ.104 FOR OUTPUT2 INPUT DATA BLOCK FOUR
C                   .EQ.105 FOR OUTPUT2 INPUT DATA BLOCK FIVE
C            NCOL = NUMBER OF COLUMNS IN MATRIX
C                   NUMBER OF ENTRIES IN TABLE, SOMETIMES
C            NROW = NUMBER OF ROWS IN MATRIX
C                   NUMBER OF ENTRIES IN TABLE, SOMETIMES
C           IFORM = CODE TO DEFINE MATRIX FORM
C                   .EQ.0 - TABLE DATA, SOMETIMES
C                   .EQ.1 - SQUARE MATRIX
C                   .EQ.2 - RECTANGULAR MATRIX
C                   .EQ.3 - DIAGONAL MATRIX
C                   .EQ.4 - LOWER TRIANGULAR MATRIX
C                   .EQ.5 - UPPER TRIANGULAR MATRIX
C                   .EQ.6 - SYMMETRIC MATRIX
C                   .EQ.7 - ROW MATRIX
C                   .EQ.8 - IDENTITY MATRIX
C           ITYPE = FLAG TO DEFINE MATRIX CONTENTS
C                   .EQ. 0 - NEXT RECORD TYPE IS A TABLE, SOMETIMES
C                   .EQ. 1 - NEXT RECORD IS REAL*4 MATRIX COLUMN
C                   .EQ. 2 - NEXT RECORD IS REAL*8 MATRIX COLUMN
C                   .EQ. 3 - NEXT RECORD IS COMPLEX*8 MATRIX COLUMN
C                   .EQ. 4 - NEXT RECORD IS COMPLEX*16 MATRIX COLUMN
C                   .GT. 4 - NEXT RECORD TYPE IS A TABLE, SOMETIMES
C          MAXWRD = THE NUMBER OF NON-ZEROS WORDS IN THE LONGEST RECORD
C           NDENS = THE DENSITY OF THE MATRIX. DIVIDE BY 100 TO 
C                   EXPRESS AS "PERCENT"
C            MORT = FLAG FOR NASTRAN PROGRAMMERS, NO USE HEREIN.
C
   30 READ(IO2,END=990) NGINO,NCOL,NROW,IFORM,ITYPE,MAXWRD,NDENS,MORT
      DENS = .01*NDENS
      WRITE(PRT,824) NGINO,NCOL,NROW,IFORM,ITYPE,MAXWRD,DENS
C
C   READ END-OF-RECORD KEY
      READ(IO2,END=990) KEY
      IF(KEY.LT.0) IREC=ABS(KEY)
      IF(KEY.LT.0) WRITE(PRT,814) IREC
C   READ DATA BLOCK HEADER NAME
      READ(IO2,END=990) KEY
      READ(IO2) LABEL2
      WRITE(PRT,826) LABEL2
C   READ END-OF-RECORD KEY
      READ(IO2,END=990) KEY
      IF(KEY.LT.0) IREC=ABS(KEY)
      IF(KEY.LT.0) WRITE(PRT,814) IREC
C
C             ****  LOOK FOR KNOWN TABLES  ****
C
      MESS = MEST
      IF(LABEL1.NE.'GPL') GO TO 65
      MESS = IRMRKT(1)
C
C          GPL TABLE HAS TWO RECORDS
C
C     RECORD 1 - LIST OF EXTERNAL GRID AND SCALAR NUMBERS IN INTERNAL
C                SORT, OUTPUT USING PUNCHI FORMAT. MATRIX ID = GPLR1.
C     RECORD 2 - PAIRS OF EXTERNAL GRID AND SCALAR NUMBERS AND SEQUENCE
C                NUMBERS IN INTERNAL SORT, OUTPUT AS TWO COLUMN REAL*4
C                ARRAY USING PUNCH FORMAT. MATRIX ID = GPLR2.
C
C   CHECK LENGTH OF RECORD
      IF(NCOL.LE.MAXSZE) GO TO 35
      WRITE(PRT,828) MAXSZE
      GO TO 20
   35 WRITE(PCH,804) LABEL1, MESS
      WRITE(PRT,805) LABEL1, MESS
C   READ LENGTH OF RECORD 1
      READ(IO2,END=990) KEY
      READ(IO2,END=990) (INPUT(K),K=1,KEY)
      WRITE(PCH,830) KEY
      WRITE(PRT,831) KEY
      IS=1
      JS=1
   40 JE=JS+13
      IF(JE.GT.KEY) JE=KEY
      WRITE(PCH,806) IS,JS,(INPUT(K),K=JS,JE)
      WRITE(PRT,807) IS,JS,(INPUT(K),K=JS,JE)
      IF(JE.EQ.KEY) GO TO 45
      JS=JS+14
      GO TO 40
   45 WRITE(PCH,810)
      WRITE(PRT,811)
C   READ END-OF-RECORD KEY
      READ(IO2,END=990) KEY
      IF(KEY.LT.0) IREC=ABS(KEY)
      IF(KEY.LT.0) WRITE(PRT,814) IREC
C   READ LENGTH OF RECORD 2
      READ(IO2,END=990) KEY
      READ(IO2,END=990) (INPUT(K),K=1,KEY)
      DO 50 K=1,KEY
   50 RROW(K) = INPUT(K)
      IS=1
      JS=1
      KD2=KEY/2
      WRITE(PCH,832) KD2
      WRITE(PRT,833) KD2
   55 JE=JS+3
      IF(JE.GT.KD2) JE=KD2
      WRITE(PCH,808) IS,JS,(RROW(2*K-1),K=JS,JE)
      WRITE(PRT,809) IS,JS,(RROW(2*K-1),K=JS,JE)
      WRITE(PCH,808) IS+1,JS,(RROW(2*K),K=JS,JE)
      WRITE(PRT,809) IS+1,JS,(RROW(2*K),K=JS,JE)
      IF(JE.EQ.KD2) GO TO 60
      JS=JS+4
      GO TO 55
   60 WRITE(PCH,810)
      WRITE(PRT,811)
      GO TO 20
C
   65 IF(LABEL1.NE.'BGPDT') GO TO 80
      MESS = IRMRKT(2)
C
C           BGPDT TABLE HAS ONE RECORD
C
C      RECORD 1 - LIST OF COORDINATE SYSTEM ID AND X,Y,Z COORDINATES
C                 FOR EACH GRID OR SCALAR POINT, OUTPUT AS FOUR COLUMN
C                 REAL*4 ARRAY USING PUNCH FORMAT. MATRIX ID = BGPDT.
C
C   CHECK LENGTH OF RECORD
      IF(NCOL.LE.MAXSZE) GO TO 70
      WRITE(PRT,828) MAXSZE
      GO TO 20
   70 WRITE(PCH,804) LABEL1, MESS
      WRITE(PRT,805) LABEL1, MESS
C   READ LENGTH OF RECORD 1
      READ(IO2,END=990) KEY
      READ(IO2,END=990) (INPUT(K),K=1,KEY)
      KD4 = KEY/4
      IC = 4
      WRITE(PCH,836) NAMET(2),KD4,IC,MESS
      WRITE(PRT,837) NAMET(2),KD4,IC,MESS
      DO 75 K=1,KEY,4
      IR = K/4+1
      IC = 1
      R1 = INPUT(K)
      R2 = RCOL(K+1)
      R3 = RCOL(K+2)
      R4 = RCOL(K+3)
      WRITE(PCH,808) IR,IC,R1,R2,R3,R4
      WRITE(PRT,809) IR,IC,R1,R2,R3,R4
   75 CONTINUE
      WRITE(PCH,810)
      WRITE(PRT,811)
      GO TO 20
C
   80 IF(LABEL1.NE.'USET') GO TO 81
      MESS = IRMRKT(3)
      GO TO 90
   81 IF(LABEL1.NE.'OGPWG') GO TO 82
      MESS = IRMRKT(4)
      GO TO 475
   82 IF(LABEL1.NE.'LAMA') GO TO 83
      MESS = IRMRKT(5)
      GO TO 525
   83 IF(LABEL1.NE.'OPHIG') GO TO 85
      MESS = IRMRKT(6)
      GO TO 575
C
C   CHECK IF DATA BLOCK IS AN UNRECOGNIZED TABLE OR A MATRIX
C   MATRIX TYPE MUST EQUAL 1,2,3,4 AND FORM MUST EQUAL 1,2,3,4,5,6.
C   IF MATRIX CONDITION NOT MET DATA ASSUMED TO BE TABLE AND OUTPUT
C   WILL BE HEXIDECIMAL.
C
   85 IF(ITYPE.LT.1) GO TO 90
      IF(ITYPE.GT.4) GO TO 90
      IF(IFORM.LT.1) GO TO 90
      IF(IFORM.GT.8) GO TO 90
      GO TO 200
C
C           GENERAL TABLE OUTPUT SECTION
C
   90 WRITE(PCH,804) LABEL1,MESS
      WRITE(PRT,805) LABEL1,MESS
C   READ LENGTH OF RECORD "ICNT"
   95 READ(IO2,END=990) KEY
      IREC=IREC+1
      IF(KEY.EQ.0) GO TO 15
      READ(IO2,END=990) (INPUT(K),K=1,KEY)
      IS = 1
      WRITE(PCH,846) LABEL2,IS,KEY,IREC,MESS
      WRITE(PRT,847) LABEL2,IS,KEY,IREC,MESS
      JS = 1
  100 JE = JS+6
      IF(JE.GT.KEY) JE=KEY
C   DON'T OUTPUT LINES OF ZEROS
      DO 102 K=JS,JE
      IF(INPUT(K).NE.0) GO TO 103
  102 CONTINUE
      GO TO 104
  103 WRITE(PCH,816) IS,JS,(INPUT(K),K=JS,JE)
      WRITE(PRT,817) IS,JS,(INPUT(K),K=JS,JE)
  104 IF(JE.EQ.KEY) GO TO 105
      JS = JS+7
      GO TO 100
  105 WRITE(PCH,810)
      WRITE(PRT,811)
C   READ END-OF-RECORD KEY
      READ(IO2,END=990) KEY
      IF(KEY.LT.0) IREC=ABS(KEY)
      IF(KEY.LT.0) WRITE(PRT,814) IREC
      GO TO 95
C
C     PARTITIONING VECTOR PROCESSING SECTION
C
  200 CONTINUE
      DO 205 K=1,MAXDBN
      IF(LABEL1.EQ.NAMEP(K)) GO TO 210
  205 CONTINUE
      GO TO 250
  210 MESS = IRMRKP(K)
C   CHECK LENGTH OF RECORD
      IF(NROW.LE.MAXSZE) GO TO 215
      WRITE(PRT,828) MAXSZE
      GO TO 20
  215 WRITE(PCH,804) LABEL1, MESS
      WRITE(PRT,805) LABEL1, MESS
C   READ LENGTH OF RECORD 1
      READ(IO2,END=990) KEY
      READ(IO2,END=990) (RROW(K),K=1,KEY)
C
C     ELEMENTS OF PARTITIONING VECTORS ARE READ IN AS REAL*4, THEY MUST
C     BE EQUAL TO EITHER 0.0 OR 1.0. CHECK THIS AND OUTPUT AS INTEGER
C     ARRAY COMPATIBLE WITH READIM.
C
      DO 225 K=1,KEY
      IF(RROW(K).EQ.0.0) GO TO 220
      IF(RROW(K).EQ.1.0) GO TO 220
C   SETUP ERROR, PARTITIONING VECTOR NOT BEING PROCESSED
      WRITE(PRT,838) LABEL1
      GO TO 20
  220 INPUT(K) = RROW(K)
  225 CONTINUE
      IS=1
      WRITE(PCH,836) LABEL1,IS,KEY,MESS
      WRITE(PRT,837) LABEL1,IS,KEY,MESS
      JS=1
  230 JE=JS+13
      IF(JE.GT.KEY) JE=KEY
      WRITE(PCH,806) IS,JS,(INPUT(K),K=JS,JE)
      WRITE(PRT,807) IS,JS,(INPUT(K),K=JS,JE)
      IF(JE.EQ.KEY) GO TO 235
      JS=JS+14
      GO TO 230
  235 WRITE(PCH,810)
      WRITE(PRT,811)
C   READ END-OF-RECORD KEY
      READ(IO2,END=990) KEY
      IF(KEY.LT.0) IREC=ABS(KEY)
      IF(KEY.LT.0) WRITE(PRT,814) IREC
      GO TO 20
C
  250 CONTINUE
C
C       REAL*8 MATRIX PROCESSING SECTION
C
      IF(ITYPE.NE.2) GO TO 350
      MESS = MESM//MESFM(IFORM)//MESTY(ITYPE)
      DO 255 K=1,MAXDBN
      IF(LABEL1.NE.NAMES(K)) GO TO 255
      MESS = IRMRKS(K)
  255 CONTINUE
C   CHECK LENGTH OF RECORD
      IF(NROW.LE.DSZE) GO TO 260
      WRITE(PRT,828) DSZE
      GO TO 20
  260 WRITE(PCH,850) LABEL1, MESFM(IFORM), MESTY(ITYPE)
      WRITE(PRT,851) LABEL1, MESFM(IFORM), MESTY(ITYPE)
      WRITE(PCH,836) LABEL1,NROW,NCOL,MESS
      WRITE(PRT,837) LABEL1,NROW,NCOL,MESS
C
C   READ THREE RECORDS (MATRIX COLUMNS) AT A TIME
C   OUTPUT DATA COMPATIBLE WITH SAMSAN SUBROUTINE READD
C
      JS=1
      NREC=3
  265 JE=JS+2
      IF(JE.GT.NCOL) JE=NCOL
      JEE = MOD(JE,3)
      IF(JEE.EQ.0) JEE=3
      DO 290 J=1,JEE
      READ(IO2,END=990) KEY
      READ(IO2,END=990) (INPUT(K),K=1,KEY)
      NREC=NREC+1
C   IF ALL ELEMENTS OF COLUMN ARE ZERO, ITS NOT ON THE OUTPUT2 TAPE
C   CHECK FOR THIS AND LOAD UP INPUT ARRAY IF SO
      IF(ABS(INPUT(1)).EQ.NREC) GO TO 270
C   READ END OF RECORD KEY
      READ(IO2,END=990) KEY
      GO TO 280
C   NULL COLUMN IMPLIED
  270 DO 275 JJ=1,KEY
  275 INPUT(JJ)=0
C   LOAD UP 3 COLUMN REAL*8 ARRAY BASED UPON EQUIVALENCE
  280 DO 285 II=1,NROW
  285 DMAT(II,J) = DCOL(II)
  290 CONTINUE
C
C      THREE COLUMNS ARE SET UP, OUTPUT NON-ZERO ROWS
C
      DO 315 II=1,NROW
      DO 305 J=1,JEE
      IF(DMAT(II,J).NE..0D0) GO TO 310
  305 CONTINUE
      GO TO 315
  310 WRITE(PCH,840) II,JS,(DMAT(II,J),J=1,JEE)
      WRITE(PRT,841) II,JS,(DMAT(II,J),J=1,JEE)
  315 CONTINUE
      IF(JE.EQ.NCOL) GO TO 320
      JS=JS+3
      GO TO 265
  320 WRITE(PCH,810)
      WRITE(PRT,810)
      GO TO 20
C
  350 IF(ITYPE.EQ.1) GO TO 400
C
C        PROGRAM NOT CODED TO HANDLE COMPLEX MATRIX DATA.
C        OUTPUT COMPLEX DATA AS HEXIDECMAL RECORD BY RECORD.
C
      WRITE(PRT,844) ITYPE,IFORM,LABEL1
      MESS = MESM//MESFM(IFORM)//MESTY(ITYPE)
      WRITE(PCH,850) LABEL1, MESFM(IFORM), MESTY(ITYPE)
      WRITE(PRT,851) LABEL1, MESFM(IFORM), MESTY(ITYPE)
C   READ LENGTH OF RECORD, DATA AND END OF RECORD CODE
  355 READ(IO2,END=990) KEY
      IF(KEY.EQ.0) GO TO 15
      LNREC = KEY
      READ(IO2,END=990) (INPUT(K),K=1,LNREC)
C   CHECK IF ALL ELEMENTS OF RECORD ARE NULL
      IF(ABS(INPUT(1)).EQ.IREC+1) GO TO 356
      READ(IO2,END=990) KEY
      GO TO 359
  356 KEY = INPUT(1)
      DO 357 JJ=1,LNREC
  357 INPUT(JJ)=0
  359 CONTINUE
      IREC=ABS(KEY)
      ICOL=IREC-3
      IS=1
      WRITE(PCH,848) LABEL1,IS,LNREC,ICOL,MESS
      WRITE(PRT,849) LABEL1,IS,LNREC,ICOL,MESS
      JS = 1
  360 JE = JS+6
      IF(JE.GT.LNREC) JE=LNREC
C   DON'T OUTPUT LINES OF ZEROS
      DO 365 K=JS,JE
      IF(INPUT(K).NE.0) GO TO 370
  365 CONTINUE
      GO TO 375
  370 WRITE(PCH,816) IS,JS,(INPUT(K),K=JS,JE)
      WRITE(PRT,817) IS,JS,(INPUT(K),K=JS,JE)
  375 IF(JE.EQ.LNREC) GO TO 380
      JS = JS+7
      GO TO 360
  380 WRITE(PCH,810)
      WRITE(PRT,811)
      IF(ICOL.LT.NCOL) GO TO 355
      GO TO 20
C
C       REAL*4 MATRIX PROCESSING SECTION
C
  400 MESS = MESM//MESFM(IFORM)//MESTY(ITYPE)
      DO 405 K=1,MAXDBN
      IF(LABEL1.NE.NAMES(K)) GO TO 405
      MESS = IRMRKS(K)
  405 CONTINUE
C   CHECK LENGTH OF RECORD
      IF(NROW.LE.MAXSZE) GO TO 410
      WRITE(PRT,828) MAXSZE
      GO TO 20
  410 WRITE(PCH,850) LABEL1, MESFM(IFORM), MESTY(ITYPE)
      WRITE(PRT,851) LABEL1, MESFM(IFORM), MESTY(ITYPE)
      WRITE(PCH,836) LABEL1,NROW,NCOL,MESS
      WRITE(PRT,837) LABEL1,NROW,NCOL,MESS
C
C   READ FOUR RECORDS (MATRIX COLUMNS) AT A TIME
C   OUTPUT DATA COMPATIBLE WITH SAMSAN SUBROUTINE READ
C
      JS=1
      NREC=3
  415 JE=JS+3
      IF(JE.GT.NCOL) JE=NCOL
      JEE = MOD(JE,4)
      IF(JEE.EQ.0) JEE=4
      DO 440 J=1,JEE
      READ(IO2,END=990) KEY
      READ(IO2,END=990) (INPUT(K),K=1,KEY)
      NREC=NREC+1
C   IF ALL ELEMENTS OF COLUMN ARE ZERO, ITS NOT ON THE OUTPUT2 TAPE.
C   CHECK FOR THIS AND LOAD UP INPUT ARRAY IF SO
      IF(ABS(INPUT(1)).EQ.NREC) GO TO 420
C   READ END OF RECORD KEY
      READ(IO2,END=990) KEY
      GO TO 430
C   NULL COLUMN IMPLIED
  420 DO 425 JJ=1,KEY
  425 INPUT(JJ)=0
C   LOAD UP 4 COLUMN REAL*4 ARRAY BASED UPON EQUIVALENCE
  430 DO 435 II=1,NROW
  435 RMAT(II,J) = RCOL(II)
  440 CONTINUE
C
C      FOUR COLUMNS ARE SET UP, OUTPUT NON-ZERO ROWS
C
      DO 455 II=1,NROW
      DO 445 J=1,JEE
      IF(RMAT(II,J).NE.0.0) GO TO 450
  445 CONTINUE
      GO TO 455
  450 WRITE(PCH,808) II,JS,(RMAT(II,J),J=1,JEE)
      WRITE(PRT,809) II,JS,(RMAT(II,J),J=1,JEE)
  455 CONTINUE
      IF(JE.EQ.NCOL) GO TO 460
      JS=JS+4
      GO TO 415
  460 WRITE(PCH,810)
      WRITE(PRT,810)
      GO TO 20
C
C         OGPWG TABLE PROCESSING SECTION
C
  475 CONTINUE
      WRITE(PCH,804) LABEL1, MESS
      WRITE(PRT,805) LABEL1, MESS
C  READ FIRST RECORD TO GET REFERENCE POINT
      READ(IO2,END=990) KEY
      READ(IO2,END=990) (INPUT(K),K=1,KEY)
      WRITE(PCH,852) INPUT(3)
      WRITE(PRT,853) INPUT(3)
C   READ END-OF-RECORD KEY
      READ(IO2,END=990) KEY
      IF(KEY.LT.0) IREC=ABS(KEY)
      IF(KEY.LT.0) WRITE(PRT,814) IREC
C  READ SECOND RECORD TO GET GPWG DATA
      READ(IO2,END=990) KEY
      READ(IO2,END=990) (INPUT(K),K=1,KEY)
      WRITE(PCH,854)
      WRITE(PRT,855)
      DO 480 K=1,6
      J=1
      JS=1+6*(K-1)
      JE=JS+3
      WRITE(PCH,808) K,J,(RCOL(I),I=JS,JE)
      WRITE(PRT,809) K,J,(RCOL(I),I=JS,JE)
      J=5
      JS=JE+1
      JE=JS+1
      WRITE(PCH,808) K,J,(RCOL(I),I=JS,JE)
      WRITE(PRT,809) K,J,(RCOL(I),I=JS,JE)
  480 CONTINUE
      WRITE(PCH,810)
      WRITE(PRT,811)
      WRITE(PCH,856)
      WRITE(PRT,857)
      DO 485 K=1,3
      J=1
      JS=37+3*(K-1)
      JE=JS+2
      WRITE(PCH,808) K,J,(RCOL(I),I=JS,JE)
      WRITE(PRT,809) K,J,(RCOL(I),I=JS,JE)
  485 CONTINUE
      WRITE(PCH,810)
      WRITE(PRT,811)
      WRITE(PCH,858)
      WRITE(PRT,859)
      DO 490 K=1,3
      J=1
      JS=46+4*(K-1)
      JE=JS+3
      WRITE(PCH,808) K,J,(RCOL(I),I=JS,JE)
      WRITE(PRT,809) K,J,(RCOL(I),I=JS,JE)
  490 CONTINUE
      WRITE(PCH,810)
      WRITE(PRT,811)
      WRITE(PCH,860)
      WRITE(PRT,861)
      DO 495 K=1,3
      J=1
      JS=58+3*(K-1)
      JE=JS+2
      WRITE(PCH,808) K,J,(RCOL(I),I=JS,JE)
      WRITE(PRT,809) K,J,(RCOL(I),I=JS,JE)
  495 CONTINUE
      WRITE(PCH,810)
      WRITE(PRT,811)
      WRITE(PCH,862)
      WRITE(PRT,863)
      DO 500 K=1,3
      JS=67+K-1
      WRITE(PCH,808) K,K,RCOL(JS)
      WRITE(PRT,809) K,K,RCOL(JS)
  500 CONTINUE
      WRITE(PCH,810)
      WRITE(PRT,811)
      WRITE(PCH,864)
      WRITE(PRT,865)
      DO 505 K=1,3
      J=1
      JS=70+3*(K-1)
      JE=JS+2
      WRITE(PCH,808) K,J,(RCOL(I),I=JS,JE)
      WRITE(PRT,809) K,J,(RCOL(I),I=JS,JE)
  505 CONTINUE
      WRITE(PCH,810)
      WRITE(PRT,811)
      GO TO 20
C
C             LAMA TABLE PROCESSING SECTION
C
  525 CONTINUE
      WRITE(PCH,804) LABEL1, MESS
      WRITE(PRT,805) LABEL1, MESS
C  READ FIRST RECORD, NOTHING NEEDED IN IT.
      READ(IO2,END=990) KEY
      READ(IO2,END=990) (INPUT(K),K=1,KEY)
C   READ END-OF-RECORD KEY
      READ(IO2,END=990) KEY
      IF(KEY.LT.0) IREC=ABS(KEY)
      IF(KEY.LT.0) WRITE(PRT,814) IREC
C  READ SECOND RECORD TO GET EIGENVALUE TABLE LISTED BY NASTRAN
      READ(IO2,END=990) KEY
      READ(IO2,END=990) (INPUT(K),K=1,KEY)
C  FIND LENGTH OF EIGENVALUE TABLE
      LEN = INPUT(KEY-6)
      WRITE(PCH,866) LEN
      WRITE(PRT,867) LEN
      DO 530 K=1,LEN
      KS=3+7*(K-1)
      KE=KS+3
      IS=1
      WRITE(PCH,808) K,IS,(RCOL(I),I=KS,KE)
      WRITE(PRT,809) K,IS,(RCOL(I),I=KS,KE)
      IS=5
      KE=KE+1
      IF(RCOL(KE).EQ.0.0) GO TO 530
      WRITE(PCH,808) K,IS,RCOL(KE)
      WRITE(PRT,809) K,IS,RCOL(KE)
  530 CONTINUE
      WRITE(PCH,810)
      WRITE(PRT,811)
      GO TO 20
C
C           OPHIG TABLE PROCESSING SECTION
C
  575 CONTINUE
      WRITE(PCH,804) LABEL1, MESS
      WRITE(PRT,805) LABEL1, MESS
C  READ FIRST RECORD, GET EIGENVALUE AND MODE NUMBER
  580 READ(IO2,END=990) KEY
      IF(KEY.EQ.0) GO TO 15
      READ(IO2,END=990) (INPUT(K),K=1,KEY)
      MODE = INPUT(5)
      EIGV = RCOL(6)
C   READ END-OF-RECORD KEY
      READ(IO2,END=990) KEY
      IF(KEY.LT.0) IREC=ABS(KEY)
      IF(KEY.LT.0) WRITE(PRT,814) IREC
C  READ SECOND RECORD TO GET POINT ID, TYPE, (6) EIGENVECTOR COMPONENTS
      READ(IO2,END=990) KEY
      READ(IO2,END=990) (INPUT(K),K=1,KEY)
C  FIND LENGTH OF EIGENVECTOR TABLE
      LEN = KEY/8
      WRITE(PCH,868) LEN,MODE,EIGV 
      WRITE(PRT,869) LEN,MODE,EIGV
      DO 590 K=1,LEN
      IS=1
      KR=1+8*(K-1)
C   GET POINT ID FROM CODED ENTRY AND TYPE (1-GRID POINT,2-SP,3-EP,4MP)
      PTID = (INPUT(KR)-1)/10
      TYPE = INPUT(KR+1)
      KS=KR+2
      KE=KR+3
      WRITE(PCH,808) K,IS,PTID,TYPE,(RCOL(I),I=KS,KE)
      WRITE(PRT,809) K,IS,PTID,TYPE,(RCOL(I),I=KS,KE)
      IS=5
      KS=KR+4
      KE=KR+7
      WRITE(PCH,808) K,IS,(RCOL(I),I=KS,KE)
      WRITE(PRT,809) K,IS,(RCOL(I),I=KS,KE)
  590 CONTINUE
      WRITE(PCH,810)
      WRITE(PRT,811)
C   READ END-OF-RECORD KEY
      READ(IO2,END=990) KEY
      IF(KEY.LT.0) IREC=ABS(KEY)
      IF(KEY.LT.0) WRITE(PRT,814) IREC
      GO TO 580
C
C     END OF JOB
C
  990 WRITE(PRT,842)
  999 REWIND IO2
      STOP
      END

      SUBROUTINE PRINTT(UNIT)
CSE
CPS   PURPOSE:
C
C            READ AND PROVIDE A HEXIDECIMAL LISTING
C            OF A NASTRAN OUTPUT2 DATA FILE
C
CPE
CAS           ***  ARGUMENT LIST  ***
C
C        UNIT  -  LOGICAL UNIT NUMBER ASSOCIATED WITH
C                 NASTRAN OUTPUT2 DATA FILE TO BE READ
C
CAE
      INTEGER UNIT
C
C     INTEGER X(5000)
      INTEGER X(10000)
      LOGICAL FLAG
C
C     DATA NWDSMX / 5000 /
      DATA NWDSMX / 10000 /
C
C   1 FORMAT(1H /(10X,10Z10))                   IBM 360
C   1 FORMAT(1H /(10X, 5O22))                   CDC 6000
    1 FORMAT(1H /(10X,10Z10))
    2 FORMAT(1H0,10X,11H*** EOR ***,I10,8X,45(2H- ))
    3 FORMAT(1H0,10X,11H*** EOF ***,I10,8X,90(1H=) )
    4 FORMAT(1H1)
C
C     IN=1
      IN=UNIT
      NOUT=I1MACH(2)
      KF=0
      FLAG=.FALSE.
      WRITE(NOUT,4)
C
  100 CONTINUE
      READ(IN,END=900) NWORDS
      WRITE(NOUT,1) NWORDS
      IF(NWORDS) 500,300,700
C
  300 CONTINUE
      KF=KF+1
      WRITE(NOUT,3) KF
      IF(FLAG) GO TO 900
      FLAG=.TRUE.
      GO TO 100
C
  500 CONTINUE
      FLAG=.FALSE.
      NWORDS=-NWORDS
      WRITE(NOUT,2) NWORDS
      GO TO 100
C
  700 CONTINUE
      FLAG=.FALSE.
      IF(NWORDS.GT.NWDSMX) GO TO 9901
      READ(IN) (X(L),L=1,NWORDS)
      DO 750 L=1,NWORDS
      IF(X(L).NE.0) GO TO 760
  750 CONTINUE
      GO TO 100
  760 WRITE(NOUT,1) (X(L),L=1,NWORDS)
      GO TO 100
C
  900 CONTINUE
      RETURN
C
 9901 WRITE(NOUT,9951) NWDSMX,NWORDS
 9951 FORMAT(42H0*** INSUFFICIENT CORE - CORE AVAILABLE = ,
     *       I10,10X,14HCORE NEEDED = ,I10)
      GO TO 9995
C
 9995 CONTINUE
      STOP 1
C
      END
